perm filename BASIC.LSP[206,JMC]2 blob sn#072129 filedate 1973-11-14 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP BASICFNS
00400	 (BASICFNS ORLIS ANDLIS MAPCAR2 MAPCHOOSE MAPAPP PRUP LISTSUBT LISTSUBTA CONTAINED DELETE PICKOUT PICKOUTA)
00500	VALUE)
00600	
00700	(DEFPROP ORLIS
00800	 (LAMBDA (PRED U) (AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
00900	EXPR)
01000	
01100	(DEFPROP ANDLIS
01200	 (LAMBDA (PRED U) (OR (NULL U) (AND (PRED (CAR U)) (ANDLIS PRED (CDR U)))))
01300	EXPR)
01400	
01500	(DEFPROP MAPCAR2
01600	 (LAMBDA (FN U V) (COND ((NULL U) NIL) (T (CONS (FN (CAR U) (CAR V)) (MAPCAR2 FN (CDR U) (CDR V))))))
01700	EXPR)
01800	
01900	(DEFPROP MAPCHOOSE
02000	 (LAMBDA(PRED FN U)
02100	  (COND	((NULL U) NIL)
02200		((PRED (CAR U)) (CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
02300		(T (MAPCHOOSE PRED FN (CDR U)))))
02400	EXPR)
02500	
02600	(DEFPROP MAPAPP
02700	 (LAMBDA (FN U) (COND ((NULL U) NIL) (T (APPEND (FN (CAR U)) (MAPAPP FN (CDR U))))))
02800	EXPR)
02900	
03000	(DEFPROP PRUP
03100	 (LAMBDA(U V)
03200	  (COND	((NULL U) (COND ((NULL V) NIL) (T (ERROR (QUOTE (V LONGER - PRUP))))))
03300		((NULL V) (ERROR (QUOTE (U LONGER - PRUP))))
03400		(T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
03500	EXPR)
03600	
03700	(DEFPROP LISTSUBT
03800	 (LAMBDA (U V) (LISTSUBTA U (DIFFERENCE (LENGTH U) (LENGTH V)) NIL))
03900	EXPR)
04000	
04100	(DEFPROP LISTSUBTA
04200	 (LAMBDA (U N Z) (COND ((EQUAL N 0) Z) (T (LISTSUBTA (CDR U) (SUB1 N) (CONS (CAR U) Z)))))
04300	EXPR)
04400	
04500	(DEFPROP CONTAINED
04600	 (LAMBDA (U V) (OR (NULL U) (AND (MEMBER (CAR U) V) (CONTAINED (CDR U) V))))
04700	EXPR)
04800	
04900	(DEFPROP DELETE
05000	 (LAMBDA (X U) (COND ((NULL U) NIL) ((EQUAL X (CAR U)) (CDR U)) (T (CONS (CAR U) (DELETE X (CDR U))))))
05100	EXPR)
05200	
05300	(DEFPROP PICKOUT
05400	 (LAMBDA (PRED U) (PICKOUTA PRED U NIL NIL))
05500	EXPR)
05600	
05700	(DEFPROP PICKOUTA
05800	 (LAMBDA(PRED U X Y)
05900	  (COND	((NULL U) (CONS X Y))
06000		((PRED (CAR U)) (PICKOUTA PRED (CDR U) (CONS (CAR U) X) Y))
06100		(T (PICKOUTA PRED (CDR U) X (CONS (CAR U) Y)))))
06200	EXPR)